unit MailList;

interface
{$I IMI.INC}

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, FormClassEmptyList, Menus, DB, ADODB, ImgList, XPMan, StdActns,
  ActnList, StdCtrls, Buttons, fcLabel, Grids, Wwdbigrd, Wwdbgrid,
  ExtCtrls, fcStatusBar; //, ExtendedMAPI;

type
  TfmMailList = class(TfmFormClassEmptyList)
    btGuncelle: TBitBtn;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
//    procedure btGuncelleClick(Sender: TObject);
  private
    { Private declarations }
    {
    FMapiSession: IMAPISession;
    FAddressBook: IAddrBook;
    FGAL: IABContainer;
    FContentsTable: IMAPITable;
    HR: HRESULT;
    FMapiInit: boolean;

    procedure MAPILocalInit;
    procedure GetExchangeAddressBook;
    procedure GetContainer(const ABContainer: IABContainer);
    }
  public
    { Public declarations }
  end;

var
  fmMailList: TfmMailList;

implementation
uses data; //, EDK, MAPIUtils;
{$R *.dfm}

{
procedure TfmMailList.GetExchangeAddressBook;
var
  ObjectType, CbENTRYID: ULONG; // Count of PENTRYID;
  ENTRYID: PENTRYID; // Pointer to ENTRYID of Exchange GAL
begin
  CbENTRYID := 0;
  ENTRYID := nil;

  hr := 0;

  try

    if not Assigned(FAddressBook) then
    begin
      hr := FMAPISession.OpenAddressBook(0, nil, AB_NO_DIALOG, FAddressBook);
      if failed(hr) then
      begin
        ShowMessage(GetMAPIError(FMAPISession, hr));
        exit;
      end;
    end;

    if not Assigned(FGAL) then
    begin
      hr := HrFindExchangeGlobalAddressList(FAddressBook, CbENTRYID, ENTRYID);

      if Failed(hr) or (CbENTRYID = 0) or not Assigned(ENTRYID) then
        if failed(hr) then
        begin
          ShowMessage(GetMAPIError(FAddressBook, hr));
          ShowMessage('The GAL (Global Address List) is NOT available!');
          exit;
        end
        else
        begin
          ShowMessage('The GAL (Global Address List) is NOT available!');
          exit;
        end;

      FGAL := nil;
      ObjectType := 0;

      hr := FAddressBook.OpenEntry(
        CbENTRYID,
        ENTRYID, @IID_IMAPIContainer,
        MAPI_BEST_ACCESS or MAPI_NO_CACHE,
        ObjectType,
        IUnknown(FGAL));

      if hr = MAPI_E_UNKNOWN_FLAGS then
        hr := FAddressBook.OpenEntry(
          CbENTRYID,
          ENTRYID, @IID_IMAPIContainer,
          MAPI_BEST_ACCESS,
          ObjectType,
          IUnknown(FGAL));

      if ((failed(hr)) or (ObjectType <> MAPI_ABCONT) or (FGAL = nil)) then
        if failed(hr) then
        begin
          ShowMessage(GetMAPIError(FAddressBook, hr));
          ShowMessage('The GAL (Global Address List) is NOT available!');
          exit;
        end
        else
        begin
          ShowMessage('The GAL (Global Address List) is NOT available!');
          exit;
        end;
    end;

  finally
    if Assigned(ENTRYID) then MAPIFreeBuffer(ENTRYID);
    if Assigned(FGAL) and Succeeded(hr) then GetContainer(FGAL);
  end;
end;

procedure TfmMailList.GetContainer(const ABContainer: IABContainer);
var
  TagArray: PSPropTagArray; // Pointer to an array of property tags identifying
                             // properties to be included
  Count: integer; // Counter
  cRows: ULONG; // Number of rows

  FContentsTablePSRowSet: PSRowSet; // Pointer to an SRowSet structure holding the table rows
  UserName: string; // Hold PR_DISPLAY_NAME value
  UserAddress: PChar; // Hold E-MAIL Address
  DISPLAYTYPE: integer;
  cbProp: ULONG;
  Prop: Pointer;
  ContainerName: string;
  ContainerDisplayType: ULONG;
begin
  assert(Assigned(ABContainer));

  TagArray := nil;
  Prop := nil;

  FContentsTablePSRowSet := nil;

  FContentsTable := nil;

  try
    hr := ABContainer.GetContentsTable(0, FContentsTable);
    if failed(hr) then
    begin
      ShowMessage(GetMAPIError(FGAL, hr));
      exit;
    end;

    // Get Container name
    hr := HrMAPIGetPropString(ABContainer, PR_DISPLAY_NAME, cbProp, Prop);
    if not failed(hr) and (cbProp > 0) then
    begin
      ContainerName := string(PChar(Prop));
      MAPIFreeBuffer(Prop);
    end
    else
      ContainerName := 'Unknown AB Container';

    // Get Container type
    hr := HrMAPIGetPropLong(ABContainer, PR_DISPLAY_TYPE, ContainerDisplayType);
    if failed(hr) then ContainerDisplayType := DT_NOT_SPECIFIC;

    hr := MAPIAllocateBuffer(SizeOf(TSPropTagArray) + SizeOf(ULONG) * 2, Pointer(TagArray));

    if Failed(hr) then exit;

    TagArray.cValues := 3;
    TagArray.aulPropTag[TagArray.cValues - 3] := PR_DISPLAY_NAME_A;
    if ContainerDisplayType = DT_GLOBAL then // maybe GAL ???
      TagArray.aulPropTag[TagArray.cValues - 2] := PR_SMTP_ADDRESS
    else
      TagArray.aulPropTag[TagArray.cValues - 2] := PR_EMAIL_ADDRESS;

    TagArray.aulPropTag[TagArray.cValues - 1] := PR_DISPLAY_TYPE;


    hr := FContentsTable.SetColumns(TagArray, TBL_BATCH);
    if failed(hr) then
    begin
      ShowMessage(GetMAPIError(FContentsTable, hr));
      exit;
    end;

    hr := FContentsTable.GetRowCount(0, cRows);
    if failed(hr) then
    begin
      ShowMessage(GetMAPIError(FContentsTable, hr));
      exit;
    end;

    while True do
    begin
      FContentsTablePSRowSet := nil;
      hr := FContentsTable.QueryRows(25, 0, FContentsTablePSRowSet);

      if Assigned(FContentsTablePSRowSet) then
        if FContentsTablePSRowSet.cRows = 0 then
        begin
          FreePRows(FContentsTablePSRowSet);
          FContentsTablePSRowSet := nil;
          Break;
        end
        else
        begin
          for Count := 0 to FContentsTablePSRowSet.cRows - 1 do
          begin
            Application.ProcessMessages;

            UserName := 'Unknown';
            DISPLAYTYPE := -1;

            if PSPropValuearray(FContentsTablePSRowSet.aRow[Count].lpProps)[0].ulPropTag = PR_DISPLAY_NAME_A then
              UserName := StrPas(PSPropValuearray(FContentsTablePSRowSet.aRow[Count].lpProps)[0].Value.lpszA);

            if PSPropValuearray(FContentsTablePSRowSet.aRow[Count].lpProps)[TagArray.cValues - 2].ulPropTag =
              TagArray.aulPropTag[TagArray.cValues - 2] then
            begin
              GetMem(UserAddress, StrLen(PSPropValuearray(FContentsTablePSRowSet.aRow[Count].lpProps)
                [TagArray.cValues - 2].Value.lpszA) + 1);
              StrCopy(UserAddress, PSPropValuearray(FContentsTablePSRowSet.aRow[Count].lpProps)
                [TagArray.cValues - 2].Value.lpszA);

              if not aqEntry.Locate('Mail', String(UserAddress), []) then
              begin
                aqEntry.Insert;
                aqEntry.FieldByName('AdSoyad').Value := UserName;
                aqEntry.FieldByName('Mail').Value := string(UserAddress);
                aqEntry.Post;
              end
              else
              begin
                if aqEntry.FieldByName('AdSoyad').AsString <> UserName then
                begin
                  aqEntry.Insert;
                  aqEntry.FieldByName('AdSoyad').Value := UserName;
                  aqEntry.Post;
                end;
              end;
            end
            else
              UserAddress := nil;
          end;

          inc(cRows, FContentsTablePSRowSet.cRows);

          if Assigned(FContentsTablePSRowSet) then
          begin
            FreePRows(FContentsTablePSRowSet);
            FContentsTablePSRowSet := nil;
          end;
        end;
    end;
  finally
    if Assigned(FContentsTablePSRowSet) then
    begin
      FreePRows(FContentsTablePSRowSet);
      FContentsTablePSRowSet := nil;
    end;

    if Assigned(TagArray) then MAPIFreeBuffer(TagArray);
  end;
end;

procedure TfmMailList.MAPILocalInit;
var
  QMess: string;
  hr: HRESULT; // MAPI Finction return HRESULT
  MAPIINIT: TMAPIINIT; // MAPI Init Structure
begin
  MAPIINIT.ulVersion := MAPI_INIT_VERSION;
  MAPIINIT.ulFlags := 0;

  try
    hr := MapiInitialize(@MAPIINIT);

    if failed(hr) then
    begin
      case hr of
        MAPI_E_INVALID_PARAMETER or MAPI_E_UNKNOWN_FLAGS: QMess := 'Invalid parameter or flag!';
        MAPI_E_TOO_COMPLEX: QMess := 'The keys required by MAPI could not be initialized.';
        MAPI_E_VERSION: QMess :=
          'The version of OLE installed on the workstation is not compatible with this version of MAPI.';
        MAPI_E_SESSION_LIMIT: QMess := 'MAPI sets up context specific to the current process.' + #13 +
          'Failures may occur on Win16 if the number of processes exceeds a certain number,' + #13 +
            'or on any system if available memory is exhausted.';
        MAPI_E_NOT_ENOUGH_RESOURCES: QMess := 'Not enough system resources were available to complete the operation.';
        MAPI_E_INVALID_OBJECT: QMess := 'May fail if system resources are exhausted.';
        MAPI_E_NOT_INITIALIZED: QMess := 'The MAPI profile provider has encountered an error.';
      else QMess := 'The MAPI Error!'
      end;
      MessageBox(0, PChar(WrapText(QMess, 80)), 'MS MAPI Subsystem', MB_OK or MB_ICONERROR);
      Exit;
    end;

    hr := MAPILogonEx(Application.Handle, nil, nil,
      MAPI_EXTENDED or
      MAPI_NEW_SESSION or
      MAPI_NO_MAIL or
      MAPI_ALLOW_OTHERS or
      MAPI_USE_DEFAULT,
      FMapiSession);


    if failed(hr) then
    begin
      case hr of
        MAPI_E_LOGON_FAILED: MessageDlg(WrapText(
            'The logon did not succeed, either because one or more of the parameters to Profile were invalid or because there were too many sessions open already.',
            80), mtError, [mbOK], 0);
        MAPI_E_TIMEOUT: MessageDlg(WrapText(
            'MAPI serializes all logons through a mutex. This is returned if the another thread held the mutex.',
            80), mtError, [mbOK], 0);
        MAPI_E_USER_CANCEL: ShowMessage(WrapText(
            'The user canceled the operation, typically by choosing the Cancel button in a dialog box.',
            80));
        MAPI_E_TOO_MANY_SESSIONS: MessageDlg(
            WrapText('The user had too many sessions open simultaneously. No session handle was returned.',
            80),
            mtError, [mbOK], 0);
        MAPI_E_UNCONFIGURED: MessageDlg(WrapText(
            'A service provider has not been configured, and therefore the operation did not complete.',
            80), mtError, [mbOK], 0);
      else MessageDlg(WrapText('The logon did not succeed', 80), mtError, [mbOK], 0);
      end;
      Exit;
    end;

    FMapiInit := True;

  finally
//    btLogOn.Enabled := FMapiInit = False;
//    btLogOff.Enabled := FMapiInit;

    if Assigned(FMAPISession) and FMapiInit then
      GetExchangeAddressBook;
  end;
end;

procedure TfmMailList.btGuncelleClick(Sender: TObject);
begin
  inherited;
  MAPILocalInit;
end;
}

procedure TfmMailList.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  inherited;
  Action := caFree;
  fmMailList := nil;
end;

procedure TfmMailList.FormShow(Sender: TObject);
begin
  inherited;
  OpenQueryOnDataSet(aqEntry.SQL.Text, aqEntry);
end;


end.

